home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
graphic
/
1svga.zip
/
LOOKC1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-29
|
5KB
|
168 lines
{ Look Chn/Eng Text/640x480,16 Colors }
uses Dos,Txt,VGA16;
var Texts:array[0..15000] of ^string;
LineMax:integer;
DirInfo:SearchRec;
Dir:DirStr; Name:NameStr; Ext:ExtStr;
Font,FontAsc,FontSpc,FontSup:pointer;
FileChn:string; { 3840,12240,10950 bytes }
{ ─────────────── InitChinese ─────────────── }
procedure InitChinese(Chn,Asc,Spc,Sup:string);
begin
if (FileLen(Asc,1)<0) then
begin Writeln; Writeln(''''+Asc+''' not found !'); Halt(1); end;
if (FileLen(Spc,1)<0) then
begin Writeln; Writeln(''''+Spc+''' not found !'); Halt(1); end;
if (FileLen(Sup,1)<0) then
begin Writeln; Writeln(''''+Sup+''' not found !'); Halt(1); end;
FileChn:=Chn;
GetMem(FontAsc,3840); FileRead(Asc,0,256,15,FontAsc^);
GetMem(FontSpc,12240); FileRead(Spc,0,408,30,FontSpc^);
GetMem(FontSup,10950); FileRead(Sup,0,365,30,FontSup^);
end;
{ ─────────────── PrintC ─────────────── }
procedure PrintC(X,Y,Color,BkColor:integer;St:string);
var Buf,Buf2:array[0..239] of byte;
S1,O1,S2,O2,S3,O3,I,Hi,Lo,N,L,P:integer;
C:word;
File1:file;
begin
S1:=Seg(FontAsc^); O1:=Ofs(FontAsc^);
S2:=Seg(FontSpc^); O2:=Ofs(FontSpc^);
S3:=Seg(FontSup^); O3:=Ofs(FontSup^);
Assign(File1,FileChn); Reset(File1,30);
L:=Length(St); P:=0;
while P<L do begin
Hi:=Ord(St[P+1]); Lo:=Ord(St[P+2]); C:=Hi shl 8+Lo;
case C of
$A440..$C67E,$C940..$F9FE:begin
if Lo>$7E then Dec(Lo,34);
N:=157*(Hi-$A4)+Lo-$40; if N>5400 then Dec(N,408);
if N<13094 then begin Seek(File1,N); BlockRead(File1,Buf,1); end
else Move(Mem[S2:O2+2580],Buf,30);
if BkColor=0 then PutX(X,Y,16,15,Color,Buf) else begin
Conv1to4(Buf,Buf2,30,Color,BkColor);
Put(X,Y,16,15,Buf2);
end;
Inc(X,16); Inc(P,2);
end;
$A140..$A3BF:begin
if Lo>$7E then Dec(Lo,34);
N:=157*(Hi-$A1)+Lo-$40;
if BkColor=0 then PutX(X,Y,16,15,Color,Mem[S2:O2+30*N]) else begin
Conv1to4(Mem[S2:O2+30*N],Buf2,30,Color,BkColor);
Put(X,Y,16,15,Buf2);
end;
Inc(X,16); Inc(P,2);
end;
$C6A1..$C8FE:begin
N:=157*(Hi-$C6)+Lo-$A1;
if BkColor=0 then PutX(X,Y,16,15,Color,Mem[S3:O3+30*N]) else begin
Conv1to4(Mem[S3:O3+30*N],Buf2,30,Color,BkColor);
Put(X,Y,16,15,Buf2);
end;
Inc(X,16); Inc(P,2);
end else begin
if BkColor=0 then PutX(X,Y,8,15,Color,Mem[S1:O1+15*Hi]) else begin
Conv1to4(Mem[S1:O1+15*Hi],Buf2,15,Color,BkColor);
Put(X,Y,8,15,Buf2);
end;
Inc(X,8); Inc(P);
end;
end;
end;
Close(File1);
end;
{ ─────────────── SetColor ─────────────── }
procedure SetColor;
const C:array[0..3] of byte=(104,80,54,30);
var Pal:array[0..314] of byte;
Pal17:array[0..16] of byte;
I:integer;
begin
VideoMode($13);
GetPalette(0,105,Pal);
SetMode(4);
for I:=0 to 3 do SetPalette(I,1,Pal[3*C[I]]);
SetPalette(4,12,Pal[64*I]);
for I:=0 to 15 do Pal17[I]:=I; Pal17[16]:=0;
SetPalette17(Pal17);
end;
{ ─────────────── ReadTextFile ─────────────── }
procedure ReadTextFile(Filename:string);
var File1:text;
St:string;
I:integer;
begin
Assign(File1,Filename); Reset(File1);
LineMax:=0;
while not Eof(File1) do begin
if (LineMax>15000) or (MemAvail<256) then begin Close(File1); Exit; end;
Readln(File1,St);
for I:=1 to 255 do if St[I]=#9 then
begin Delete(St,I,1); Insert(' ',St,I); end;
GetMem(Texts[LineMax],Length(St)+1);
Texts[LineMax]^:=St;
Inc(LineMax);
end;
Close(File1);
end;
{ ─────────────── ShowPage ─────────────── }
procedure ShowPage(X,Y:integer);
var N,I,J:integer;
St:string[80];
begin
if LineMax>24 then J:=24 else J:=LineMax;
for I:=0 to J-1 do begin
N:=Length(Texts[Y+I]^)-X;
if N<0 then N:=0; if N>80 then N:=80;
St[0]:=Chr(N); Move(Texts[Y+I]^[X+1],St[1],N);
PrintC(0,25+18*I,4+I shr 1,0,St);
Bar(N shl 3,25+18*I,(80-N) shl 3,15,0);
end;
end;
{ ─────────────── Look ─────────────── }
procedure Look;
var X,Y,K:integer;
St:string[5];
begin
FSplit(ParamStr(1),Dir,Name,Ext);
ReadTextFile(Dir+DirInfo.Name);
Bar(0,0,640,20,2); Bar(0,460,640,20,2);
PrintC(16, 2,3,2,'LookC V1.1 ññ¡^ñσÑ╗ñσ└╔╛\┼¬╡{ªí (C) 1994 Jou-Nan Chen');
PrintC(16,462,3,2,'í⌠í⌡í≈í÷,PgUp,PgDn,Home,End-┬╜╛\Ñ╗ñσ Esc-┬≈╢}');
X:=0; Y:=0; K:=0;
repeat
Bar(528,2,72,15,2);
Str(Y+1,St); PrintC(528,2,6,2,St);
Str(X+1,St); PrintC(576,2,6,2,St);
if (K<>$2166) and (K<>$2146) then ShowPage(X,Y);
K:=Key;
case K of
$4800:Dec(Y); $5000:Inc(Y); { Up,Down }
$4900:Dec(Y,24); $5100:Inc(Y,24); { PgUp,PgDn }
$4B00:Dec(X,20); $4D00:Inc(X,20); { Left,Right }
$4700:begin X:=0; Y:=0; end; { Home }
$4F00:begin X:=0; Y:=LineMax-24; end; { End }
end;
if Y>LineMax-24 then Y:=LineMax-24; if Y<0 then Y:=0;
if X>236 then X:=236; if X<0 then X:=0;
until K=$011B; { Esc }
end;
begin
if ParamCount=0 then
begin Writeln('Usage: Look Filename'); Halt(1); end;
if ParamCount=1 then begin
FindFirst(ParamStr(1),Archive,DirInfo);
if DosError<>0 then
begin Writeln('No such file !'); Halt(1); end;
end;
InitChinese('\et3\stdfont.15','\et3\ascfont.15','\et3\spcfont.15',
'\et3\spcfsupp.15');
SetColor; Look; SetMode(0);
end.